MacHack 2000/MacHack 2000.toast/pc/The Hacks/Easy as pi dcmd ƒ/pi.p

Text File | 2000-06-23 | 9.1 KB | 274 lines

{    Easy as pi dcmd }
{    Created at MacHack 2000 by Philippe Casgrain }
{    [e-mail] }

{    This file is best viewed in a monospace font. }

{    This dcmd does the reverse of the 'pp' dcmd, that is given the proper  }
{    MixedMode information it will return the hex value for the ProcInfoType. }

{    This hack is actually useful to non-C programmers since they don't have }
{    access to the macros in MixedMode.h to build the ProcInfoType from  }
{    scratch each time the source is compiled. }

{    The skeleton of this dcmd is based on the 'Blat' pascal dcmd, which was written }
{    by Bo3b Johnson on 8/28/91. All of the code was written by PhC except for the }
{    'LowerStr255' and 'NumberToHex' functions, which were taken from MacApp anyway. }

{    This dcmd compiles well under MPW 3.2 using the old style interfaces. I have not }
{    attempted to make it compile under 3.3 and universal interfaces, mostly because }
{    I use the Pascal compiler which is 68k only so the new routine names don't  }
{    really matter. }

unit pi;

{$R-}
{ debug labels on. }
{$D+}

interface

    uses
        MemTypes, Packages, Scrap, {}
        dcmd; { Macsbug interface routines. }

    { Public declaration for dcmdGlue. Must be in every dcmd. The name cannot be changed. }
    procedure CommandEntry (paramPtr: dcmdBlockPtr);

implementation

    const
        kHexDigits = '0123456789ABCDEF';    { Digits in base 16, for hex conversion. }
    type
        Str8 = string[8]; { When passing back hex numbers on the stack, best to use small ones. }


{-------------------------------------------------------------------------------------------}
{ Comment by Bo3b Johnson }
{ Well, I stole this routine from MacApp utilities.  I want to lower case the strings so I }
{    don't have case sensitivities.  This will do it, without using the toolbox. }
    procedure LowerStr255 (var s: Str255);
        var
            i: Integer;
    begin
        for i := 1 to Length(s) do
            if (s[i] in ['A'..'Z']) then
                s[i] := Chr(Ord(s[i]) + 32)
    end; { LowerStr255 }


{-------------------------------------------------------------------------------------------}
{ Comment by Bo3b Johnson }
{ Another handy routine stolen from MacApp to do the conversion on the dang strings.  I }
{    only pass back Str8, since that is the maximum length, and stack space is limited in }
{    Macsbug, and I don't want to waste it needlessly.  }
{    Notably, this one handles negative LongInts properly, unlike the one distributed with }
{    the dcmd samples. }
    function NumberToHex (decNumber: univ LongInt): Str8;
        var
            i: Integer;
            hexNumber: Str8;
    begin
        hexNumber[0] := Chr(8);
        for i := 8 downto 1 do begin
                hexNumber[i] := kHexDigits[BAnd(decNumber, 15) + 1];
                decNumber := BSR(decNumber, 4);
            end;
        NumberToHex := hexNumber;
    end; { NumberToHex }

{ This function looks at the first parameter to pi, which should be the calling }
{ convention. If it is not understood, dump an error message. }
    function ParseFirstParameter (var dumpString: Str255; var result: LongInt): boolean;
        var
            parseChar: Char;
    begin
        result := -1;
        parseChar := dcmdGetNextParameter(dumpString);
        LowerStr255(dumpString);
        if dumpString = 'kpascalstackbased' then
            result := 0;
        if dumpString = 'kcstackbased' then
            result := 1;
        if dumpString = 'kregisterbased' then
            result := 2;
        if dumpstring = 'kthinkcstackbased' then
            result := 5;
        if dumpstring = 'kd0dispatchedpascalstackbased' then
            result := 8;
        if dumpstring = 'kd0dispatchedcstackbased' then
            result := 9;
        if dumpstring = 'kd1dispatchedpascalstackbased' then
            result := 12;
        if dumpstring = 'kstackdispatchedpascalstackbased' then
            result := 14;
        if dumpstring = 'kspecialcase' then
            result := 15;

        ParseFirstParameter := (result >= 0);
    end; { ParseFirstParameter }

{ This shows the help message if the user simply typed 'pi' or 'help pi'. }
{ If there was an error parsing the dumpString in ParseFirstParameter above, }
{ explain that we could not figure out the calling convention (first parameter). }
    procedure ShowHelpText (dumpString: Str255);

    begin
        if (dumpString = '') then begin { there was no parameter or a help request, dump the help text }
                dcmdDrawLine('pi   kPascalStackBased | kCStackBased | kRegisterBased | kThinkCStackBased |');
                dcmdDrawLine('    kD0DispatchedPascalStackBased | kD0DispatchedCStackBased |');
                dcmdDrawLine('    kD1DispatchedPascalStackBased | kStackDispatchedPascalStackBased |');
                dcmdDrawLine('    kSpecialCase | result_size stack_parameter_1_size stack_parameter_2_size ...');
                dcmdDrawLine('');
                dcmdDrawLine('  Returns the ProcInfoType long word using the information provided');
                dcmdDrawLine('  (reverse of the pp dcmd). [e-mail], MacHack 2000');
            end
        else begin { first parameter not understood }
                dumpString := Concat('  pi does not understand the "', dumpString, '" parameter.');
                dcmdDrawLine(dumpString);
                dcmdDrawLine('  Type "help pi" for more information.');
            end;
    end; { ShowHelpText }

{ Writes the header of useful information if it was not written already. }
    procedure WriteHeader (var headerWritten: Boolean; c: Integer; result, value: LongInt);
        var
            s: Str255;
    begin
        if not headerWritten then begin
                s := 'The ProcinfoType for a ';
                if (c = 0) or (value = 0) then { nothing to return on the stack so it must be a procedure }
                    s := Concat(s, 'procedure')
                else
                    s := Concat(s, 'function');

                s := Concat(s, ' with the following parameters:');
                dcmdDrawLine(s);
                case result of
                    0:
                        s := 'kPascalStackBased';
                    1:
                        s := 'kCStackBased';
                    2:
                        s := 'kRegisterBased';
                    5:
                        s := 'kThinkCStackBased';
                    8:
                        s := 'kD0DispatchedPascalStackBased';
                    9:
                        s := 'kD0DispatchedCStackBased';
                    12:
                        s := 'kD1DispatchedPascalStackBased';
                    14:
                        s := 'kStackDispatchedPascalStackBased';
                    15:
                        s := 'kSpecialCase';
                    otherwise
                        s := 'can''t happen!';
                end; { case }
                s := Concat('Calling convention   : ', s);
                dcmdDrawLine(s);

                headerWritten := true;
            end; { headerWritten }

    end; { WriteHeader }

{ This just sets the right bits, starting at basebit, for the size of }
{ parameters to pass on the stack (including the return value). For more }
{ information, see IM:Mixed Mode Manager. }
    procedure SetBits (var result: LongInt; baseBit: Integer; value: LongInt);
    begin
        case value of
            1:
                BSet(result, baseBit);
            2:
                BSet(result, baseBit + 1);
            4:  begin
                    BSet(result, baseBit);
                    BSet(result, baseBit + 1);
                end;
            otherwise { in this case, leave as-is (should be both clear }
                ;
        end; { case }
    end; { SetBits }

{-------------------------------------------------------------------------------------------}


{ This procedure is the main entry point for the dcmd.  It is the hook by which we get }
{    called by MacsBug to do our thing. It is basically the chance to key off the command }
{    line and do what it requests. }
    procedure CommandEntry (paramPtr: DCmdBlockPtr);
        var
            parseChar: Char;
            okParse, headerWritten: Boolean;
            dumpString, s1, s2: Str255;
            c, curBaseBit: Integer;
            value, result: LongInt;
            err: OSErr;

    begin
        case paramPtr^.request of
            dcmdInit:
                ; { We have no initalizations to do in this very simple dcmd }

            dcmdDoIt:  begin { here the dcmd is being called with (hopefully) a command line of options }
                    result := 0;
                    if ParseFirstParameter(dumpString, result) then begin { We have the first parameter's string }
                            c := 0; { count of extra parameters }
                            curBaseBit := 2; { high-order bit to set }
                            headerWritten := false;
                            repeat
                                parseChar := dcmdGetNextExpression(value, okParse);
                                if okParse then begin
                                        c := c + 1;
                                        curBaseBit := curBaseBit + 2;

                                        WriteHeader(headerWritten, c, result, value);

                                        if c = 1 then begin { second parameter is size of result on the stack }
                                                NumToString(value, s1);
                                                s1 := Concat('Size of return value : ', s1);
                                                dcmdDrawLine(s1);
                                            end
                                        else begin { c > 1, we are looking at the size of parameters }
                                                NumToString(c - 1, s1);
                                                s2 := 'Size of parameter ';
                                                if c < 10 then
                                                    s2 := Concat(s2, ' '); { add padding space! }
                                                s1 := Concat(s2, s1, ' : ');
                                                NumToString(value, s2);
                                                s1 := Concat(s1, s2, ' bytes');
                                                dcmdDrawLine(s1);
                                            end; { c > 1 }

                                        SetBits(result, curBaseBit, value);

                                    end
                                else
                                    WriteHeader(headerWritten, c, result, value);
                            until parseChar = Chr(13); { end of parameter line }
                            dcmdDrawLine('');
                            s2 := NumberToHex(result);
                            s1 := Concat('is: ', s2);
                            dcmdDrawLine(s1);

{ An experiment in putting the result on the clipboard... }
{ You shouldn't be doing this since these calls may move memory and }
{ MacsBug can be called at interrupt time, when memory should *not* }
{ move. }
{                            err := ZeroScrap;}
{                            err := PutScrap(8, 'TEXT', @s2[1]);}
                        end { if  }
                    else
                        ShowHelpText(dumpString);
                end; { dcmdDoIt }

                dcmdHelp:
                    ShowHelpText(''  );
        end; { case paramPtr^.request. }

    end; { CommandEntry }

end.